Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyNotifier.p

Text File | 1997-01-17 | 6KB | 247 lines

unit MyNotifier;

{ Derived from <[e-mail]> Joe Holt's StartupError code as posted }
{ to comp.sys.mac.programmer in May 1991 }

{ Notification Manager messages }

{ History: }
{   jhh 18 jun 90 -- response to news posting }
{   pnl 29 may 91 -- Converted to pascal to be used in an application }

interface

    uses
        Types, Memory;

    const
        mark_app = 1;
        mark_none = 0;
        notify_no_string = 0;
        notify_use_str = 0;
        notify_no_sicn = 0;
        notify_mark = true;
        notify_no_mark = false;
        notify_sound = true;
        notify_no_sound = false;
        notify_no_display = 0;

    procedure StartupNotifier;
    procedure NotifyH (mark: integer; sound: Handle; sicn: Handle; str: StringPtr; display_time: longint);
    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longint);
{ mark - mark the current application }
{ sound - play sysbeep }
{ sicn_id, sicn_index - SICN id to rotate with the apple & index (<1 -> 1)   OR 0&0 for no sicn }
{ str_id, str_index - STR# id & index    OR    STR id & 0    OR    0 & 0 }
    procedure UnNotify;
{ Call this to get rid of the notification }

    var
        notify_finished, notify_outstanding: boolean;
        time_to_unnotify: longint;

implementation

    uses
        Types, Notification, GestaltEqu, Icons, OSUtils, TextUtils, Resources, Events,
        MyStartup, MySystemGlobals, MyMemory, MyAssertions;

    const
        sicn_size = 32;
        T_NMInstall = $A05E;
        T_Unimplemented = $A89F;

    type
        NMRecPtrPtr = ^NMRecPtr;
        booleanPtr = ^boolean;

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

    var
        current_note: NMRecPtr;

    var
        gMyResponseProc : UniversalProcPtr;

{ handles must be non-purgeable, but may be unlocked }

    procedure MyResponse (note: NMRecPtr);
    begin
        booleanPtr(note^.nmRefCon)^ := true;
    end;

    procedure UnNotify;
        var
            oe: OSErr;
    begin
        if current_note <> nil then begin
            oe := NMRemove(current_note);
            with current_note^ do begin
                if nmStr <> nil then begin
                    MDisposePtr( nmStr );
                end;
                if nmIcon <> nil then begin
                    MDisposeHandle(nmIcon);
                end;
            end;
            MDisposePtr( current_note );
        end;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
    end;

    procedure NotifyH (mark: integer; sound: Handle; sicn: Handle; str: StringPtr; display_time: longint);
        var
            error: boolean;
            oe: OSErr;
    begin
        AssertDidStartup( startup_check );
        UnNotify;            { Clear outstanding notify }
        if NGetTrapAddress(T_NMInstall, OSTrap) = NGetTrapAddress(T_Unimplemented, ToolTrap) then begin
            SysBeep(1);   { Best we can do I guess.  Could put up the dialog box maybe?...}
        end else begin
            if MNewPtr( current_note, SizeOf(NMRec) ) <> noErr then begin
                SysBeep(1);   { Can't do much else if there isnt even room for this! }
            end else begin
                with current_note^ do begin
                    qType := nmType;
                    error := false;
                    booleanPtr(nmRefCon) := @notify_finished;
                    nmMark := mark;
                    nmStr := str;
                    nmIcon := sicn;
                    nmSound := sound;
                    nmResp := gMyResponseProc;
                end;
                oe := NMInstall(current_note);
                if oe <> noErr then begin
                    current_note := nil;
                    SysBeep(1);
                end else begin
                    notify_outstanding := true;
                    if display_time > 0 then begin
                        time_to_unnotify := TickCount + display_time;
                    end;
                end;
            end;
        end;
    end;

    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longint);
        var
            errorText: Str255;
            sh: StringHandle;
            sicnH: Handle;
            error: boolean;
            nmMark: integer;
            nmStr: StringPtr;
            nmIcon: Handle;
            nmSound: Handle;
            gv: longint;
    begin
        Assert( (sicn_id >= 0) & (sicn_index > 0) & (str_id >= 0) & (str_index >= 0) & (display_time >= 0) );
        error := false;
        if mark then begin
            nmMark := 1;
        end else begin
            nmMark := 0;
        end;
        nmStr := nil;
        if str_id <> notify_no_string then begin
            if str_index > 0 then begin
                GetIndString(errorText, str_id, str_index);
            end else begin
                errorText := '';
                sh := GetString(str_id);
                if sh <> nil then begin
                    if sh^ <> nil then begin
                        errorText := sh^^;
                    end;
                    ReleaseResource(Handle(sh));
                end;
            end;
            if errorText = '' then begin
                error := true;
            end else begin
                if MNewPtr( nmStr, length(errorText) + 1 ) <> noErr then begin
                    error := true;
                end else begin
                    nmStr^ := errorText;
                end;
            end;
        end;
        nmIcon := nil;
        if sicn_id <> notify_no_sicn then begin

            nmIcon := nil;
            if (Gestalt(gestaltSystemVersion, gv) = noErr) & (gv >= $0700) then begin
                if GetIconSuite(nmIcon, sicn_id, svAllSmallData) <> noErr then begin
                    nmIcon := nil;
                end;
            end;
            if nmIcon = nil then begin
                Assert( sicn_index > 0 );
                if sicn_index < 1 then begin
                    sicn_index := 1;
                end;
                sicn_index := (sicn_index - 1) * sicn_size;   { 1-based, like STR# }
                sicnH := GetResource('SICN', sicn_id);
                HNoPurge(sicnH);
                if sicnH = nil then begin
                    error := true;
                end else begin
                    if MNewHandle( nmIcon, sicn_size ) <> noErr then begin
                        error := true;
                    end else if GetHandleSize(sicnH) < sicn_index + sicn_size then begin
                        error := true;
                    end else begin
                        BlockMoveData(Ptr(longint(sicnH^) + sicn_index), nmIcon^, sicn_size);
                    end;
                    ReleaseResource(sicnH);
                end;
            end;
        end;
        if sound or error then begin
            nmSound := Handle(-1);
        end else begin
            nmSound := nil;
        end;
        NotifyH(nmMark, nmSound, nmIcon, nmStr, display_time);
    end;

    function InitNotifier(var msg: integer): OSStatus;
    begin
{$unused(msg)}
        DidStartup( startup_check );
        current_note := nil;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
        gMyResponseProc := NewNMProc(MyResponse);
        InitNotifier := noErr;
    end;

    procedure FinishNotifier;
    begin
        if current_note <> nil then begin
            UnNotify;
        end;
    end;

    procedure IdleNotifier;
    begin
        if (notify_finished and InForeground) or (TickCount > time_to_unnotify) then begin
            UnNotify;
        end;
    end;

    procedure StartupNotifier;
    begin
        SetStartup(InitNotifier, IdleNotifier, 10, FinishNotifier);
    end;

end.